home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 June (DVD) / DPPRO0605DVD.iso / Install / program files / Borland / BDS / 3.0 / Demos / Delphi.Net / CLR / NETrix / PlayFld.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-10-22  |  14.3 KB  |  589 lines
  1. unit PlayFld;
  2.  
  3. interface
  4.  
  5. uses System.Drawing, System.Windows.Forms;
  6.  
  7.     // We assume that the playing field
  8.     // cannot be bigger than 100x100, and the
  9.     // game piece is limited to 4x4
  10. CONST MAX_PIECE =  3;
  11.       MAX_FIELD = 99;
  12.  
  13. type
  14.   MyColors =
  15.   (
  16.     Red     = 1,
  17.     Blue    = 2,
  18.     Orange  = 3,
  19.     Yellow  = 4,
  20.     Lime    = 5,
  21.     Aqua    = 6,
  22.     Magenta = 7,
  23.     Black   = 8
  24.   );
  25.  
  26.   TPiece = Array[0..MAX_PIECE, 0..MAX_PIECE] of Integer;
  27.   TGamePiece = class;
  28.  
  29.   TPlayingField = class(System.Windows.Forms.PictureBox)
  30.   private
  31.  
  32.     FOwner: System.Windows.Forms.Form;
  33.     gp: TGamePiece;
  34.     MainTimer: Timer;
  35.     RowsRemoved: Integer;
  36.     CurrentDelay: Integer;
  37.  
  38.     procedure TimerEvent(sender: System.Object; e: System.EventArgs);
  39.     procedure GameOver;
  40.     procedure EmptyPlayingField;
  41.     procedure SpeedUp(r: Integer);
  42.     procedure RemoveRow(r: Integer);
  43.     procedure RemoveRows(score: Integer);
  44.     function  ConsolidatePiece(p: TGamePiece): Boolean;
  45.  
  46.   strict protected
  47.     procedure OnPaint(e: PaintEventArgs); override;
  48.  
  49.   public
  50.     FieldHeight: Integer;
  51.     FieldWidth: Integer;
  52.  
  53.     pfmatrix: Array[0..MAX_FIELD, 0..MAX_FIELD] of Integer; //col, row
  54.  
  55.     constructor Create(aOwner: Form; x, y, h, w: Integer);
  56.  
  57.     procedure Drop;
  58.     procedure GoDown;
  59.     procedure GoLeft;
  60.     procedure GoRight;
  61.     procedure NewGame;
  62.     procedure PauseGame;
  63.     procedure ResumeGame;
  64.     procedure TurnClockwise;
  65.     procedure TurnCounterclockwise;
  66.   end;
  67.  
  68.   TGamePiece = class
  69.   private
  70.     FOwner: TPlayingField;
  71.     cColor, nColor: MyColors;
  72.     cMaxCols, cMaxRows: Integer;
  73.     nMaxCols, nMaxRows: Integer;
  74.     cPiece, nPiece: TPiece; //current, next
  75.     col, row: Integer;
  76.  
  77.     procedure InitPiece;
  78.     procedure ClearPiece(VAR piece: TPiece);
  79.     procedure Rotate(clockwise: Boolean);
  80.     function  Overlap(piece: TPiece; MaxCols, MaxRows: Integer): Boolean;
  81.     procedure DropDown;
  82.     procedure ConsolidatePiece;
  83.     procedure StepDown;
  84.     procedure StepLeft;
  85.     procedure StepRight;
  86.  
  87.   public
  88.     constructor Create(aOwner: TPlayingField);
  89.   end;
  90.  
  91. implementation
  92.  
  93. uses WinForm;
  94.  
  95. function GetColorValue(i: Integer; default: Color): Color;
  96. begin
  97.     case (i) of
  98.       Integer(MyColors.Red):     Result := Color.Red;
  99.       Integer(MyColors.Lime):    Result := Color.Lime;
  100.       Integer(MyColors.Orange):  Result := Color.Orange;
  101.       Integer(MyColors.Blue):    Result := Color.Blue;
  102.       Integer(MyColors.Yellow):  Result := Color.Yellow;
  103.       Integer(MyColors.Black):   Result := Color.Black;
  104.       Integer(MyColors.Magenta): Result := Color.Magenta;
  105.       Integer(MyColors.Aqua):    Result := Color.Aqua;
  106.       else                       Result := default;
  107.     end;
  108. end;
  109.  
  110.  
  111. constructor TPlayingField.Create(aOwner: Form; x, y, h, w: Integer);
  112. begin
  113.   inherited Create;
  114.  
  115.   FOwner := aOwner;
  116.  
  117.   FieldWidth := 10;
  118.   FieldHeight := 20;
  119.   CurrentDelay := 500;
  120.  
  121.   Self.Parent := FOwner;
  122.   Self.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top
  123.       or System.Windows.Forms.AnchorStyles.Bottom) or System.Windows.Forms.AnchorStyles.Right)));
  124.   Self.BorderStyle := System.Windows.Forms.BorderStyle.None;
  125.   Self.Location := System.Drawing.Point.Create(x, y);
  126.   Self.Name := 'MainPanel';
  127.   Self.Size := System.Drawing.Size.Create(h, w);
  128.   Self.TabIndex := 3;
  129.  
  130.   EmptyPlayingField();
  131.   gp := TGamePiece.Create(Self);
  132.  
  133.   MainTimer := Timer.Create;
  134.   Include(MainTimer.Tick, Self.TimerEvent);
  135. end;
  136.  
  137. PROCEDURE TPlayingField.EmptyPlayingField;
  138. VAR row, col: Integer;
  139. begin
  140.   for row := 0 to Pred(FieldHeight) do
  141.     for col := 0 to Pred(FieldWidth) do
  142.       pfmatrix[col,row] := 0
  143. end;
  144.  
  145. procedure TPlayingField.OnPaint(e: PaintEventArgs);
  146. VAR g: Graphics;
  147.     b: SolidBrush;
  148.     p: Pen;
  149.     hor_offset, ver_offset, current: Integer;
  150.     r,c,x: Integer;
  151. begin
  152.   g := e.Graphics;
  153.  
  154.   SuspendLayout();
  155.  
  156.   b := SolidBrush.Create(Color.FromArgb(180, Color.White));
  157.  
  158.   if ((Width / (FieldWidth + MAX_PIECE+2)) < (Height / FieldHeight)) then
  159.     x := Width div (FieldWidth + MAX_PIECE+2)
  160.   else
  161.     x := Height div FieldHeight;
  162.  
  163.   hor_offset := (Width - x * (FieldWidth + MAX_PIECE+2)) div 2;
  164.   ver_offset := (Height - x * FieldHeight) div 2;
  165.  
  166.   p := Pen.Create(Color.Gray);
  167.  
  168.   g.DrawLine(p, hor_offset,
  169.                 ver_offset,
  170.                 hor_offset,
  171.                 ver_offset+x * (MAX_PIECE+1));
  172.   g.DrawLine(p, hor_offset,
  173.                 ver_offset+x * (MAX_PIECE+1),
  174.                 hor_offset+x * (MAX_PIECE+1),
  175.                 ver_offset+x * (MAX_PIECE+1));
  176.   g.DrawLine(p, hor_offset+x * (MAX_PIECE+1),
  177.                 ver_offset+x * (MAX_PIECE+1),
  178.                 hor_offset+x * (MAX_PIECE+1),
  179.                 ver_offset);
  180.   g.DrawLine(p, hor_offset,
  181.                 ver_offset,
  182.                 hor_offset+x * (MAX_PIECE+1),
  183.                 ver_offset);
  184.  
  185.   for r := 0 to MAX_PIECE do
  186.     for c := 0 to MAX_PIECE do
  187.     begin
  188.       b.Color := GetColorValue(gp.nPiece[c,r], BackColor);
  189.       g.FillRectangle(b, hor_offset+1+c*x,
  190.                          ver_offset+1+(MAX_PIECE-r)*x,
  191.                          x-1,x-1);
  192.     end;
  193.  
  194.   hor_offset := hor_offset+x * (MAX_PIECE+2);
  195.  
  196.   g.DrawLine(p, hor_offset,
  197.                 ver_offset,
  198.                 hor_offset,
  199.                 ver_offset+x * FieldHeight);
  200.   g.DrawLine(p, hor_offset,
  201.                 ver_offset+x * FieldHeight,
  202.                 hor_offset+x * FieldWidth,
  203.                 ver_offset+x * FieldHeight);
  204.   g.DrawLine(p, hor_offset+x * FieldWidth,
  205.                 ver_offset+x * FieldHeight,
  206.                 hor_offset+x * FieldWidth,
  207.                 ver_offset);
  208.  
  209.   Dec(x);
  210.  
  211.   for r := 0 to Pred(FieldHeight) do
  212.     for c := 0 to Pred(FieldWidth) do
  213.     begin
  214.       current := pfmatrix[c,r];
  215.  
  216.       if Assigned(gp) then
  217.       begin
  218.         if ((gp.row <= r) AND (r < gp.row+gp.cMaxRows) AND
  219.             (gp.col <= c) AND (c < gp.col+gp.cMaxCols)) then
  220.             current := current OR gp.cPiece[c-gp.col,r-gp.row];
  221.       end;
  222.  
  223.       b.Color := GetColorValue(current, BackColor);
  224.       g.FillRectangle(b, hor_offset+1+c*(x+1), ver_offset+1+(FieldHeight-1-r)*(x+1),x,x);
  225.     end;
  226.   ResumeLayout(false);
  227. end;
  228.  
  229. procedure TPlayingField.SpeedUp(r: Integer);
  230. begin
  231.   if (r > 10) then Exit; { don't speed up at the top }
  232.   Inc(RowsRemoved);
  233.   if ((RowsRemoved > 35) AND (CurrentDelay > 450)) then
  234.     Dec(CurrentDelay, 50);
  235.   if ((RowsRemoved > 55) AND (CurrentDelay > 400)) then
  236.     Dec(CurrentDelay, 50);
  237.   if ((RowsRemoved > 75) AND (CurrentDelay > 350)) then
  238.     Dec(CurrentDelay, 50);
  239.   if ((RowsRemoved > 85) AND (CurrentDelay > 300)) then
  240.     Dec(CurrentDelay, 50);
  241.   if ((RowsRemoved > 90) AND (CurrentDelay > 250)) then
  242.     Dec(CurrentDelay, 50);
  243.   if ((RowsRemoved > 95) AND (CurrentDelay > 200)) then
  244.     Dec(CurrentDelay, 50);
  245.   if ((RowsRemoved > 100) AND (CurrentDelay > 150)) then
  246.     Dec(CurrentDelay, 50);
  247. end;
  248.  
  249. procedure TPlayingField.RemoveRow(r: Integer);
  250. VAR row, col: Integer;
  251. begin
  252.   SpeedUp(r);
  253.   (FOwner as TWinForm).AddScore(10*(r+1));
  254.  
  255.   for row := r to Pred(FieldHeight-1) do
  256.     for col := 0 to Pred(FieldWidth) do
  257.       pfmatrix[col,row] := pfmatrix[col,row+1];
  258.  
  259.   for col := 0 to Pred(FieldWidth) do
  260.     pfmatrix[col,FieldHeight-1] := 0;
  261. end;
  262.  
  263. procedure TPlayingField.RemoveRows(score: Integer);
  264. VAR hole: Boolean;
  265.     c,r: Integer;
  266. begin
  267.   r := 0;
  268.   (FOwner as TWinForm).AddScore(score);
  269.   repeat
  270.     hole := false;
  271.     for c := 0 to Pred(FieldWidth) do
  272.       if (pfmatrix[c,r] = 0) then hole := true;
  273.     if (hole) then
  274.       Inc(r)
  275.     else
  276.       RemoveRow(r);
  277.   until (r >= FieldHeight);
  278. end;
  279.  
  280. procedure TPlayingField.GoLeft;
  281. begin
  282.   if Assigned(gp) then gp.StepLeft();
  283. end;
  284.  
  285. procedure TPlayingField.GoRight;
  286. begin
  287.   if Assigned(gp) then gp.StepRight();
  288. end;
  289.  
  290. procedure TPlayingField.TurnClockwise;
  291. begin
  292.   if Assigned(gp) then gp.Rotate(true);
  293. end;
  294.  
  295. procedure TPlayingField.TurnCounterclockwise;
  296. begin
  297.   if Assigned(gp) then gp.Rotate(false);
  298. end;
  299.  
  300. procedure TPlayingField.GoDown;
  301. begin
  302.   if Assigned(gp) then gp.StepDown();
  303. end;
  304.  
  305. procedure TPlayingField.Drop;
  306. begin
  307.   if Assigned(gp) then gp.DropDown();
  308. end;
  309.  
  310. procedure TPlayingField.TimerEvent(sender: System.Object; e: System.EventArgs);
  311. begin
  312.   if Assigned(gp) then gp.StepDown();
  313. end;
  314.  
  315. procedure TPlayingField.PauseGame;
  316. begin
  317.   MainTimer.Enabled := false
  318. end;
  319.  
  320. procedure TPlayingField.ResumeGame;
  321. begin
  322.   MainTimer.Enabled := true;
  323. end;
  324.  
  325. procedure TPlayingField.GameOver;
  326. begin
  327.   MainTimer.Enabled := false;
  328.   (FOwner as TWinForm).GameOver();
  329. end;
  330.  
  331. procedure TPlayingField.NewGame;
  332. begin
  333.   EmptyPlayingField();
  334.   RowsRemoved := 0;
  335.   CurrentDelay := 500;
  336.   Invalidate();
  337.   gp.InitPiece();
  338.   MainTimer.Interval := CurrentDelay;
  339.   MainTimer.Enabled := true;
  340. end;
  341.  
  342. function  TPlayingField.ConsolidatePiece(p: TGamePiece): Boolean;
  343. VAR count,c,r: Integer;
  344. begin
  345.   Result := false;
  346.  
  347.   if (p.row + p.cMaxRows > FieldHeight) then
  348.     GameOver()
  349.   else begin
  350.     count := 0;
  351.     for c := 0 to Pred(FieldWidth) do
  352.       for r := 0 to Pred(FieldHeight) do
  353.         if ((p.row <= r) AND (r < p.row+p.cMaxRows) AND
  354.             (p.col <= c) AND (c < p.col+p.cMaxCols)) then
  355.             begin
  356.               pfmatrix[c,r] := pfmatrix[c,r] OR p.cPiece[c-p.col,r-p.row];
  357.               if (p.cPiece[c-p.col,r-p.row] <> 0) then Inc(count);
  358.             end;
  359.  
  360.     RemoveRows(count);
  361.     Invalidate();
  362.  
  363.     Result := true;
  364.   end;
  365. end;
  366.  
  367. {  TGamePiece  }
  368.  
  369. constructor TGamePiece.Create(aOwner: TPlayingField);
  370. begin
  371.   inherited Create;
  372.   FOwner := aOwner;
  373.   InitPiece;
  374.   InitPiece;
  375. end;
  376.  
  377. procedure TGamePiece.ClearPiece(VAR piece: TPiece);
  378. VAR i,j: Integer;
  379. begin
  380.   for i := 0 to MAX_PIECE do
  381.     for j := 0 to MAX_PIECE do
  382.       piece[i,j] := 0
  383. end;
  384.  
  385. procedure TGamePiece.InitPiece;
  386. VAR i,c,r: Integer;
  387.     rdm: System.Random;
  388. begin
  389.   for c := 0 to MAX_PIECE do
  390.     for r := 0 to MAX_PIECE do
  391.       cPiece[c,r] := nPiece[c,r];
  392.  
  393.   cColor := nColor;
  394.   cMaxCols := nMaxCols;
  395.   cMaxRows := nMaxRows;
  396.  
  397.   col := FOwner.FieldWidth div 2 - 1;
  398.   row := FOwner.FieldHeight;
  399.  
  400.   rdm := System.Random.Create(Integer(DateTime.Now.Ticks));
  401.  
  402.   repeat
  403.     i := rdm.Next(1, 9);
  404.     nColor := MyColors(i);
  405.   until (cColor <> nColor);
  406.  
  407.   case (rdm.Next(1,8)) of
  408.     1: begin
  409.           //  WW
  410.           //  WW
  411.           ClearPiece(nPiece); //{i,i},{i,i}
  412.           nPiece[0,0] := i;
  413.           nPiece[0,1] := i;
  414.           nPiece[1,0] := i;
  415.           nPiece[1,1] := i;
  416.           nMaxCols := 2;
  417.           nMaxRows := 2;
  418.        end;
  419.  
  420.     2: begin
  421.           //  W
  422.           //  W
  423.           //  W
  424.           //  W
  425.           ClearPiece(nPiece); //{i,i,i,i}
  426.           nPiece[0,0] := i;
  427.           nPiece[0,1] := i;
  428.           nPiece[0,2] := i;
  429.           nPiece[0,3] := i;
  430.           nMaxCols := 1;
  431.           nMaxRows := 4;
  432.        end;
  433.     3: begin
  434.           //  W
  435.           //  W
  436.           //  WW
  437.           ClearPiece(nPiece); //{i,i,i},{0,0,i}
  438.           nPiece[0,0] := i;
  439.           nPiece[0,1] := i;
  440.           nPiece[0,2] := i;
  441.           nPiece[1,2] := i;
  442.           nMaxCols := 2;
  443.           nMaxRows := 3;
  444.        end;
  445.     4: begin
  446.           //   W
  447.           //   W
  448.           //  WW
  449.           ClearPiece(nPiece); //{0,0,i},{i,i,i}
  450.           nPiece[0,2] := i;
  451.           nPiece[1,0] := i;
  452.           nPiece[1,1] := i;
  453.           nPiece[1,2] := i;
  454.           nMaxCols := 2;
  455.           nMaxRows := 3;
  456.        end;
  457.     5: begin
  458.           //  W
  459.           //  WW
  460.           //   W
  461.           ClearPiece(nPiece); //{i,i,0},{0,i,i}
  462.           nPiece[0,0] := i;
  463.           nPiece[0,1] := i;
  464.           nPiece[1,1] := i;
  465.           nPiece[1,2] := i;
  466.           nMaxCols := 2;
  467.           nMaxRows := 3;
  468.        end;
  469.     6: begin
  470.           //   W
  471.           //  WW
  472.           //  W
  473.           ClearPiece(nPiece); //{0,i,i},{i,i,0}
  474.           nPiece[1,0] := i;
  475.           nPiece[0,1] := i;
  476.           nPiece[1,1] := i;
  477.           nPiece[0,2] := i;
  478.           nMaxCols := 2;
  479.           nMaxRows := 3;
  480.        end;
  481.     else begin
  482.           //   W
  483.           //  WW
  484.           //   W
  485.           ClearPiece(nPiece); //{0,i,0},{i,i,i}
  486.           nPiece[1,0] := i;
  487.           nPiece[0,1] := i;
  488.           nPiece[1,1] := i;
  489.           nPiece[1,2] := i;
  490.           nMaxCols := 2;
  491.           nMaxRows := 3;
  492.        end;
  493.   end; { case }
  494. end;
  495.  
  496. procedure TGamePiece.Rotate(clockwise: Boolean);
  497. VAR c,r: Integer;
  498.     xPiece: TPiece;
  499. begin
  500.   ClearPiece(xPiece);
  501.  
  502.   if (clockwise) then
  503.   begin
  504.     for c := 0 to Pred(cMaxCols) do
  505.       for r := 0 to Pred(cMaxRows) do
  506.         xPiece[cMaxRows-1-r,c] := cPiece[c,r];
  507.   end
  508.   else begin
  509.     for c := 0 to Pred(cMaxCols) do
  510.       for r := 0 to Pred(cMaxRows) do
  511.         xPiece[r,cMaxCols-1-c] := cPiece[c,r];
  512.   end;
  513.  
  514.   if (NOT Overlap(xPiece, cMaxRows, cMaxCols)) then
  515.   begin
  516.     for c := 0 to MAX_PIECE do
  517.       for r := 0 to MAX_PIECE do
  518.         cPiece[c,r] := xPiece[c,r];
  519.     c := cMaxRows;
  520.     cMaxRows := cMaxCols;
  521.     cMaxCols := c;
  522.     FOwner.Invalidate;
  523.   end;
  524. end;
  525.  
  526. function TGamePiece.Overlap(piece: TPiece; MaxCols, MaxRows: Integer): Boolean;
  527. VAR c,i,j: Integer;
  528. begin
  529.   Result := true;
  530.  
  531.   if ((col < 0) OR (row < 0)) then Exit;
  532.   if (col + MaxCols > FOwner.FieldWidth) then Exit;
  533.  
  534.   for i := 0 to Pred(MaxCols) do
  535.     for j := 0 to Pred(MaxRows) do
  536.       if (row + j < FOwner.FieldHeight) then
  537.       begin
  538.         c := piece[i,j];
  539.         if ((c>0) AND (FOwner.pfmatrix[i+col,j+row]>0)) then Exit;
  540.       end;
  541.   Result := false;
  542. end;
  543.  
  544. procedure TGamePiece.DropDown;
  545. begin
  546.   repeat
  547.     Dec(row)
  548.   until Overlap(cPiece, cMaxCols, cMaxRows);
  549.   Inc(row);
  550.   ConsolidatePiece();
  551.   FOwner.Invalidate();
  552. end;
  553.  
  554. procedure TGamePiece.StepDown;
  555. begin
  556.   Dec(row);
  557.   if Overlap(cPiece, cMaxCols, cMaxRows) then
  558.   begin
  559.     Inc(row);
  560.     ConsolidatePiece();
  561.   end;
  562.   FOwner.Invalidate();
  563. end;
  564.  
  565. procedure TGamePiece.StepLeft;
  566. begin
  567.   Dec(col);
  568.   if Overlap(cPiece, cMaxCols, cMaxRows) then
  569.     Inc(col)
  570.   else
  571.     FOwner.Invalidate()
  572. end;
  573.  
  574. procedure TGamePiece.StepRight;
  575. begin
  576.   Inc(col);
  577.   if Overlap(cPiece, cMaxCols, cMaxRows) then
  578.     Dec(col)
  579.   else
  580.     FOwner.Invalidate()
  581. end;
  582.  
  583. procedure TGamePiece.ConsolidatePiece;
  584. begin
  585.   if FOwner.ConsolidatePiece(Self) then InitPiece()
  586. end;
  587.  
  588. end.
  589.